home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 19 / madtrb11.zip / TIMESTMP.PAS < prev    next >
Pascal/Delphi Source File  |  1985-07-13  |  2KB  |  107 lines
  1. { TIMESTAMP AND KBIN Routines }
  2.  
  3. {
  4. Source: "TIMESTAMP and KBIN for the IBM-PC", TUG Lines Volume I Issue 2
  5. Author: Karl Gerhard
  6. Date:   7/5/84
  7. Application: PC-DOS, MS-DOS
  8. }
  9.  
  10. type
  11.   stdstr = string[80];
  12.  
  13.   RecPack = record
  14.      AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAG:integer;
  15.   end;
  16.  
  17. var
  18.   regs:RecPack;
  19.   ch:char;
  20.  
  21. {------------------------}
  22. function StrInt(n:integer):stdstr;
  23.   { return a string with the integer in ASCII }
  24. var s:string[6];
  25. begin
  26. str(n,s);
  27. strint := s;
  28. end;
  29.  
  30. {------------------------}
  31.  procedure CallDos(fcn:integer);
  32.   { execute DOS fcn# call }
  33.  begin
  34.  with regs do begin
  35.  ax := fcn;
  36.  MsDos(regs);
  37.  end; { with }
  38.  end;
  39.  
  40.  
  41. {---------------------------}
  42. function kbin:char;
  43.  
  44.   { returns key value entered at keyboard
  45.     immediately; no display, handle extended codes  }
  46.  
  47. var
  48. c:char;
  49. n:integer;
  50.  
  51. begin
  52.   CallDOS($800);  { DOS pg D-8 }
  53.   n := Lo(regs.ax);
  54.  
  55. if n = 25 then begin  { ^Y to halt }
  56.     writeln('^Y  program halting.  What is condition of open files?');
  57.     delay(200);
  58.     halt;
  59.   end;
  60.  
  61.   if n = 0 then begin  { ext code }
  62.     CallDOS($800);
  63.     n := Lo(regs.ax);
  64.     if n > 127 then n := n - 124;
  65.     n := n + 128;
  66.   end;  { ext }
  67.   kbin := chr(n);
  68. end;
  69.  
  70. {------------------------}
  71. function timestamp:stdstr;
  72.   { return string of "MON DAY YEAR TIME" }
  73. type mot = array[1..12] of string[3];
  74. const mon:mot = ( 'JAN','FEB','MAR','APR','MAY','JUN',
  75.                   'JUL','AUG','SEP','OCT','NOV','DEC');
  76. var tsret:stdstr; hr:integer;   ampm:string[2];
  77. begin
  78. CallDos($2A00);
  79. with regs do begin
  80. tsret :=  mon[Hi(DX)] +' '+ strint(Lo(DX)) +','+ strint(CX)+ '  ';
  81.  
  82. CallDos($2C00);
  83. hr := Hi(cx);
  84. if hr > 12 then begin
  85.   hr := hr - 12;
  86.   ampm := 'pm';
  87. end
  88. else
  89.   ampm := 'am';
  90. timestamp := tsret + (strint(hr) ) + ':' + (strint(Lo(cx)) )+ampm;
  91. end;  { with }
  92. end;
  93.  
  94. {-  main block for the demo  -}
  95. begin
  96. writeln( 'Demonstration of the TimeStamp function: ',timestamp); writeln;
  97. writeln('The following demonstrates kbin vs keypress (entering q will quit)');
  98. repeat
  99.   writeln(' using kbin to get extended codes');
  100.   ch := kbin;
  101.   writeln(ch, ord(ch):4);
  102.   writeln( ' Using read(kbd,ch)');
  103.   read(kbd,ch);
  104.   writeln(ch, ord(ch):4);
  105. until ch = 'q';
  106. end.
  107.